home *** CD-ROM | disk | FTP | other *** search
- {*
- *
- * Copyright (c) 1992,93 by Richard W. Hansen
- *
- * This source code will compile.
- * Full source code available to registered users.
- *
- *}
- (* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
- UNIT TVOBJECT ;{$B+} {$X+} {$V-} {$I TVDEFS.INC} INTERFACE USES TVSTRING , OBJECTS ;TYPE PBXOBJECT =^TBXOBJECT ;
- TBXOBJECT =OBJECT (TOBJECT)FUNCTION GETTEXT (MAXLEN :INTEGER ):STRING ;VIRTUAL;END ;PBXSELECTOBJECT =^TBXSELECTOBJECT ;
- TBXSELECTOBJECT =OBJECT (TBXOBJECT)SELECTED :BOOLEAN ;CONSTRUCTOR LOAD (VAR S :TSTREAM );FUNCTION GETSELECT :BOOLEAN ;
- VIRTUAL;PROCEDURE SETSELECT (ASTATE :BOOLEAN );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );END ;
- PBXSELECTSTR =^TBXSELECTSTR ;TBXSELECTSTR =OBJECT (TBXSELECTOBJECT)ST :PSTRING ;CONSTRUCTOR INIT (CONST ASTRING :STRING
- );CONSTRUCTOR LOAD (VAR S :TSTREAM );DESTRUCTOR DONE ;VIRTUAL;FUNCTION GETTEXT (MAXLEN :INTEGER ):STRING ;VIRTUAL;
- PROCEDURE STORE (VAR S :TSTREAM );END ;PBXCOLLECTION =^TBXCOLLECTION ;
- TBXCOLLECTION =OBJECT (TSORTEDCOLLECTION)FUNCTION COMPARE (KEY1 ,KEY2:POINTER ):INTEGER ;VIRTUAL;END ;
- PBXUNSORTEDSTRINGCOLLECTION =^TBXUNSORTEDSTRINGCOLLECTION ;
- TBXUNSORTEDSTRINGCOLLECTION =OBJECT (TSTRINGCOLLECTION)PROCEDURE INSERT (ITEM :POINTER );VIRTUAL;END ;
- PROCEDURE REGISTERTVOBJECT ;CONST RBXSELECTOBJECT :TSTREAMREC =(OBJTYPE :5150 ;
- VMTLINK :OFS (TYPEOF (TBXSELECTOBJECT )^);LOAD :@ TBXSELECTOBJECT . LOAD ;STORE :@ TBXSELECTOBJECT . STORE );
- CONST RBXSELECTSTR :TSTREAMREC =(OBJTYPE :5151 ;VMTLINK :OFS (TYPEOF (TBXSELECTSTR )^);LOAD :@ TBXSELECTSTR . LOAD ;
- STORE :@ TBXSELECTSTR . STORE );CONST RBXCOLLECTION :TSTREAMREC =(OBJTYPE :5152 ;
- VMTLINK :OFS (TYPEOF (TBXCOLLECTION )^);LOAD :@ TBXCOLLECTION . LOAD ;STORE :@ TBXCOLLECTION . STORE );
- CONST RBXUNSORTEDSTRINGCOLLECTION :TSTREAMREC =(OBJTYPE :5153 ;VMTLINK :OFS (TYPEOF (TBXUNSORTEDSTRINGCOLLECTION )^);
- LOAD :@ TBXUNSORTEDSTRINGCOLLECTION . LOAD ;STORE :@ TBXUNSORTEDSTRINGCOLLECTION . STORE );
- IMPLEMENTATION FUNCTION TBXOBJECT.GETTEXT (MAXLEN:INTEGER):STRING ;BEGIN RUNERROR (211 );END ;
- CONSTRUCTOR TBXSELECTOBJECT.LOAD (VAR S:TSTREAM);BEGIN S.READ (SELECTED , SIZEOF (BOOLEAN ));END ;
- FUNCTION TBXSELECTOBJECT.GETSELECT :BOOLEAN ;BEGIN GETSELECT := SELECTED ;END ;PROCEDURE TBXSELECTOBJECT.SETSELECT
- (ASTATE:BOOLEAN);BEGIN SELECTED := ASTATE ;END ;PROCEDURE TBXSELECTOBJECT.STORE (VAR S:TSTREAM);BEGIN S.WRITE (SELECTED ,
- SIZEOF (BOOLEAN ));END ;CONSTRUCTOR TBXSELECTSTR.INIT (CONST ASTRING:STRING );BEGIN INHERITED INIT;ST := NEWSTR (ASTRING
- );END ;CONSTRUCTOR TBXSELECTSTR.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );ST := S.READSTR ;END ;
- DESTRUCTOR TBXSELECTSTR.DONE ;BEGIN DISPOSESTR (ST );INHERITED DONE;END ;FUNCTION TBXSELECTSTR.GETTEXT
- (MAXLEN:INTEGER):STRING ;BEGIN GETTEXT := FTRUNCATESTR (ST ^, MAXLEN );END ;PROCEDURE TBXSELECTSTR.STORE (VAR S:TSTREAM);
- BEGIN INHERITED STORE(S );S.WRITESTR (ST );END ;FUNCTION TBXCOLLECTION.COMPARE (KEY1,KEY2:POINTER):INTEGER ;
- VAR Ol00lOl:STRING ;Ol0O000:STRING ;BEGIN Ol00lOl := PBXOBJECT (KEY1 )^. GETTEXT (255 );Ol0O000 := PBXOBJECT (KEY2 )^.
- GETTEXT (255 );IF (Ol00lOl < Ol0O000 )THEN COMPARE := - 1 ELSE IF (Ol00lOl > Ol0O000 )THEN COMPARE := 1 ELSE COMPARE := 0
- ;END ;PROCEDURE TBXUNSORTEDSTRINGCOLLECTION.INSERT (ITEM:POINTER);BEGIN ATINSERT (COUNT , ITEM );END ;
- PROCEDURE REGISTERTVOBJECT ;BEGIN REGISTERTYPE (RBXSELECTOBJECT );REGISTERTYPE (RBXSELECTSTR );REGISTERTYPE
- (RBXCOLLECTION );REGISTERTYPE (RBXUNSORTEDSTRINGCOLLECTION );END ;END .
-